home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / cad / acadlsp.zip / EDIT.LSP < prev    next >
Text File  |  1987-09-28  |  10KB  |  329 lines
  1. ; EDIT Version 1.0
  2. ; Copyright 1987 Alacrity
  3. ;
  4. ; Jason Osgood
  5. ; 12405 SE 25th
  6. ; Bellevue, WA. 98005
  7. ;
  8. ; CompuServe ID: 73417,1756
  9.  
  10. (defun *error* (msg)
  11.    (princ "\nerror: ")
  12.    (princ msg)
  13.    (terpri)
  14. )
  15.  
  16. (defun c:EDIT (/ char ss p1 p2 linlst num i len p lst ins tab new old txt str
  17.                  txtlin item ent entdata txtlst entlst insert delete brktxt
  18.                  jointxt deltxt modtxt chglin status cursor mode comlin
  19.                  display)
  20.  (setq tab (strcat "+" (chr 205) (chr 205) (chr 205) (chr 205))
  21.        i 0 p 1 num 0 linlst (list) txtlst (list) entlst (list) txtlin 0)
  22.  (setvar "CmdEcho" 0)
  23.  (princ " Version 1.0 (c)1987 Alacrity")
  24.  
  25.  (defun delete (lst i)
  26.      (cond ((zerop i) (cdr lst))
  27.            (T (cons (car lst) (delete (cdr lst) (1- i))))
  28.      )
  29.  )
  30.  (defun insert (lst item i)
  31.      (cond ((zerop i) (cons item lst))
  32.            (T (cons (car lst) (insert (cdr lst) item (1- i))))
  33.      )
  34.  )
  35.  (defun modtxt (txtlin txt old)
  36.      (princ "\e[2J")
  37.      (repeat 24 (terpri))
  38.      (graphscr)
  39.      (entmod (subst (cons 1 txt) (cons 1 old) (entget (nth txtlin entlst))))
  40.      (setq txtlst (insert (delete txtlst txtlin) txt txtlin))
  41.      (getstring "Press [ENTER] to continue.")
  42.      (display)
  43.  )
  44.  (defun comlin ()
  45.     (princ "\e[2;1H")
  46.     (princ "\e[K")
  47.  )
  48.  (defun mode (i)
  49.     (setq ins (not i))
  50.     (princ "\e[s")
  51.     (princ "\e[2;8H")
  52.     (princ (if ins "ON " "OFF"))
  53.     (princ "\e[u")
  54.  )
  55.  (defun cursor ()
  56.      (princ "\e[2;32H")
  57.      (princ p)
  58.      (princ " ")
  59.      (princ "\e[")
  60.      (princ (+ 4 (* 2 txtlin)))
  61.      (princ ";")
  62.      (princ  p)
  63.      (princ "H")
  64.  )
  65.  (defun status ()
  66.      (comlin)
  67.      (princ "Insert ")
  68.      (princ (if ins "ON " "OFF"))
  69.      (princ "    Line ")
  70.      (princ (1+ txtlin))
  71.      (princ " ")
  72.      (princ "\e[2;25H")
  73.      (princ "Column ")
  74.      (princ p)
  75.      (princ " \n")
  76.  )
  77.  (defun chglin (i)
  78.      (if (/= old txt) (modtxt txtlin txt old))
  79.      (setq txtlin (+ i txtlin) p 1 txt (nth txtlin txtlst) old txt
  80.            len (strlen txt))
  81.      (princ "\e[2;20H")
  82.      (princ (1+ txtlin))
  83.      (princ " ")
  84.      (cursor)
  85.  )
  86.  (defun display ()
  87.      (textscr)
  88.      (princ "\e[2J")
  89.      (princ (strcat "EDIT (C)1987 Alacrity F2-Mod F3-Join F4-Brk F5-" (chr 30)
  90.         " F6-" (chr 31) " F7-" (chr 17) " F8-" (chr 16) " F9-Del F10-Ins\n"))
  91.  
  92.      (status)
  93.      (repeat 16 (princ tab))
  94.      (mapcar '(lambda (str) (princ (strcat str "\004\n\n"))) txtlst)
  95.  )
  96.  
  97.  (defun deltxt ()
  98.      (princ "\e[2J")
  99.      (repeat 24 (terpri))
  100.      (graphscr)
  101.      (entdel (nth txtlin entlst))
  102.      (setq txtlst (delete txtlst txtlin) entlst (delete entlst txtlin)
  103.            num (1- num) txt nil old nil)
  104.      (display)
  105.      (if (> num 0)
  106.         (if (= txtlin 0)
  107.            (chglin 0)
  108.            (progn
  109.            (setq txtlin (1- txtlin))
  110.            (chglin -1)
  111.            )
  112.         )
  113.      )
  114.  )
  115.  
  116.  (defun jointxt ()
  117.     (comlin)
  118.     (if (and (setq i (getint "Join line number: "))
  119.              (/= (1- i) txtlin) (< (1- i) num) (> i 0))
  120.       (progn
  121.       (setq i (1- i))
  122.       (princ "\e[2J")
  123.       (repeat 24 (terpri))
  124.       (entdel (nth i entlst))
  125.       (setq txt (strcat (substr txt 1 (1- p)) (nth i txtlst) (substr txt p)))
  126.       (entmod (subst (cons 1 txt) (cons 1 old) (entget (nth txtlin entlst))))
  127.       (setq txtlst (insert (delete txtlst txtlin) txt txtlin)
  128.             txtlst (delete txtlst i) entlst (delete entlst i)
  129.             num (1- num) old txt len (strlen txt))
  130.       (if (< i txtlin) (setq txtlin (1- txtlin)))
  131.       (display)
  132.       (cursor)
  133.       )
  134.       (progn
  135.       (status)
  136.       (cursor)
  137.       )
  138.    )
  139.  )
  140.  
  141.  (defun brktxt ()
  142.      (princ "\e[2J")
  143.      (repeat 24 (terpri))
  144.      (graphscr)
  145.      (setq new (substr txt p) txt (substr txt 1 (1- p)))
  146.      (while (not (setq p1 (getpoint "Start point: "))))
  147.      (setq entdata (entget (setq ent (nth txtlin entlst))))
  148.      (if (equal (setq p2 (cdr (assoc 11 entdata))) '(0.000000 0.000000))
  149.           (setq p2 (cdr (assoc 10 entdata)))
  150.      )
  151.      (command "COPY" ent "" p2 p1)
  152.      (entmod (subst (cons 1 txt) (cons 1 old) entdata))
  153.      (entmod (subst (cons 1 new) (cons 1 old) (entget (entlast))))
  154.      (setq old txt num (1+ num)
  155.            txtlst (insert (insert (delete txtlst txtlin) txt txtlin)
  156.               new (1+ txtlin))
  157.            entlst (insert entlst (entlast) (1+ txtlin))
  158.      )
  159.      (display)
  160.      (chglin 1)
  161.  )
  162.  
  163.  (gc)
  164.  (if (setq ss (ssget))
  165.      (progn
  166.      (setq num (sslength ss))
  167.      (while (and (< i num) (< i 10))
  168.         (if (/= (cdr (assoc 0 (entget (setq ent (ssname ss i))))) "TEXT")
  169.            (progn
  170.            (ssdel ent ss)
  171.            (setq num (1- num))
  172.            )
  173.            (progn
  174.            (setq entlst (append entlst (list ent))
  175.                  txtlst (append txtlst (list (cdr (assoc 1 (entget ent)))))
  176.                  i (1+ i)
  177.            )
  178.            )
  179.         )
  180.      )
  181.      (setq num (length txtlst))
  182.      )
  183.   )
  184.   (if txtlst
  185.      (progn
  186.      (display)
  187.      (chglin 0)
  188.      (while (not (or (= (cadr (setq char (grread))) 27) (< num 1)))
  189.      (if (= (car char) 2)
  190.        (progn
  191.        (setq char (cadr char))
  192.        (if (not (or (< char 31) (> char 126)))
  193.           (if ins
  194.              (progn
  195.              (setq txt (strcat (substr txt 1 (1- p))
  196.                        (princ (chr char))
  197.                        (princ (substr txt p)))
  198.              )
  199.              (princ "\004")
  200.              (setq p (1+ p) len (1+ len))
  201.              (cursor)
  202.              )
  203.              (progn
  204.              (setq txt (strcat (substr txt 1 (1- p))
  205.                        (princ (chr char))
  206.                        (substr txt (1+ p)))
  207.              )
  208.              (if (> p len)
  209.                  (progn
  210.                  (setq len (1+ len))
  211.                  (princ "\004")
  212.                  )
  213.              )
  214.              (setq p (1+ p))
  215.              (cursor)
  216.              )
  217.           )
  218.           (cond
  219.                ((not (or (/= char 7) (< p 2))) ; left
  220.                     (progn
  221.                      (setq p (1- p))
  222.                      (cursor)
  223.                     )
  224.                )
  225.                ((not (or (/= char 15) (> p len))) ;right
  226.                     (progn
  227.                      (setq p (1+ p))
  228.                      (cursor)
  229.                     )
  230.                )
  231.                ((= char 20) (mode ins)) ; ins
  232.                ((not (or (/= char 2) (> p len))) ; del
  233.                     (progn
  234.                      (setq txt (strcat (substr txt 1 (1- p))
  235.                           (princ (substr txt (1+ p))))
  236.                      )
  237.                      (princ "\004 ")
  238.                      (setq len (1- len))
  239.                      (cursor)
  240.                     )
  241.                )
  242.                ((not (or (/= char 8) (< p 2))) ; backspace
  243.                     (progn
  244.                      (setq p (1- p))
  245.                      (cursor)
  246.                      (setq txt (strcat (substr txt 1 (1- p))
  247.                           (princ (substr txt (1+ p))))
  248.                      )
  249.                      (princ "\004 ")
  250.                      (setq len (1- len))
  251.                      (cursor)
  252.                     )
  253.                )
  254.                ((= char 189) (jointxt)) ; join F3
  255.                ((= char 190) ; break F4
  256.                     (if (not (or (< p 2) (>= p len) (> num 9)))
  257.                        (brktxt)
  258.                     )
  259.                )
  260.                ((= char 143) ; shift tab
  261.                     (progn
  262.                      (if (= (/ (1- p) 5) (/ (1- p) 5.0))
  263.                           (setq p (- p 5))
  264.                           (setq p (1+ (* (/ (1- p) 5) 5)))
  265.                      )
  266.                      (if (< p 1) (setq p 1))
  267.                      (cursor)
  268.                     )
  269.                )
  270.                ((= char 9) ; tab
  271.                     (progn
  272.                      (if (= (/ (1- p) 5) (/ (1- p) 5.0))
  273.                           (setq p (+ p 5))
  274.                           (setq p (+ 6 (* (/ (1- p) 5) 5)))
  275.                      )
  276.                      (if (>= p len) (setq p (1+ len)))
  277.                      (cursor)
  278.                     )
  279.                )
  280.                ((= char 238) ; begin
  281.                     (progn
  282.                      (setq p 1)
  283.                      (cursor)
  284.                     )
  285.                )
  286.                ((= char 239) ; end
  287.                     (progn
  288.                      (setq p (1+ len))
  289.                      (cursor)
  290.                     )
  291.                )
  292.                ((= char 188) ; modify F2
  293.                     (if (/= old txt)
  294.                          (progn
  295.                           (modtxt txtlin txt old)
  296.                           (setq old txt)
  297.                           (cursor)
  298.                          )
  299.                     )
  300.                )
  301.                ((or (= char 4) (= char 13)) ; down F6
  302.                     (if (and (< txtlin (1- num)) (< txtlin 10))
  303.                          (chglin 1)
  304.                          (chglin 0)
  305.                     )
  306.                )
  307.                ((not (or (/= char 191) (<= txtlin 0))) ; up F5
  308.                     (chglin -1)
  309.                )
  310.           )
  311.      )
  312.      )
  313.   )
  314.     (if (< len 1) (deltxt))
  315.   )
  316.  (princ "\e[2J")
  317.  (repeat 24 (terpri))
  318.  (graphscr)
  319.  (if (/= old txt)
  320.      (entmod (subst (cons 1 txt) (cons 1 old) (entget (nth txtlin entlst))))
  321.  )
  322.  )
  323.  )
  324.  (command)
  325. )
  326.  
  327.  
  328.  
  329.